perm filename OPARRY[4,KMC]4 blob
sn#038867 filedate 1973-04-23 generic text, type T, neo UTF8
00100 BEGIN
00200
00300 % ##### PARANOID MODEL ##### %
00400
00500
00600 NEW POINTERS, DELNO, LASTSTMT, DELFLAG, FLARE, FLAG, FLARELIST, REMARK,
00700 WEIGHT, DELAY, NREF, QWORD, GLOBX, GLOBY, TERMIN, RESTSENT, ANGER, FEAR, MISTRUST, ANGER0, FEAR0,
00800 MISTRUST0, TRACEV, DLIM, SUPPRESS, SENSITIVELIST, DELNLIST, DELVLIST, DELALIST, LIVEFLARES,
00900 LASTTOP, DEADFLARES, X, REST, SKEP, DELEND, AJUMP, FJUMP, TELL, NLIST, TVAL, SACTS, WEAK, INTERPERS,
01000 EOF, MESSAGE, ENDE, TALK, SAVE_FILE;
01100
01200 SPECIAL POINTERS, DELNO, LASTSTMT, DELFLAG, FLARE,
01300 SENSITIVELIST, FLAG, FLARELIST, WEIGHT, DELAY, NREF, QWORD, GLOBX, GLOBY,
01400 TERMIN, RESTSENT, ANGER, FEAR, MISTRUST, ANGER0, FEAR0, MISTRUST0, SUPPRESS,
01500 TRACEV, X, DLIM, DELNLIST, DELVLIST, DELALIST, LIVEFLARES, DEADFLARES, DELEND, SKEP, REST,
01600 LASTTOP, AJUMP, FJUMP, TELL, NLIST, TVAL, SACTS, WEAK, INTERPERS,
01700 EOF, MESSAGE, ENDE, TALK, SAVE_FILE, FILE1, FILE2, REMARK, CHAR;
01800 %ALOOCATIONS FOR RECONSTRUCTING PARRY
01900 R LISP 39
02000 FULL WORDS=3300
02100 BINARY PROGRAM SPACE=12000 %
02200 %THE FOLLOWING FUNCTION IS TO FIX OCTAL-DECIMAL PROBLEM %
02300
02400 FEXPR LAPIN (L);
02500 BEGIN NEW IBASE;
02600 IBASE←8;
02700 RETURN EVAL (`DSKIN CONS L);
02800 END;
02900
03000
03100 % ***** MAIN FUNCTIONS ***** %
03200
03300
03400 %
03500 INITIALIZE %
03600
03700 EXPR INITIALIZE ();
03800 BEGIN
03900 NEW VALUE,I, CONCEPT, WORD, SL, FL, DN, DV, AN, AV, ANV, AL, QL, RL, WTS, WT;
04000 SPECIAL VALUE, CONCEPT, WORD, SL, FL, DN, DV, AN, AV, ANV, AL, QL, RL, WTS, WT;
04100
04200 INITFN 'RESTART;
04300 IF ¬GET('SEND_MAIL,'SUBR) THEN % MAKE SURE THE DATA HAS BEEN READ IN. %
04400 BEGIN
04500 EVAL '(INC (INPUT (4 KMC) RDATA) NIL);
04600 WHILE NOT ATOM X ← ERRSET(READ(),T) DO EVAL CAR X;
04700 INC(NIL,T);
04800 END;
04900
05000 NLIST←GET ('NEGS, 'IND); % NEGATORS %
05100 SACTS←GET ('SACTS, 'IND); % META-ACTS, E.G. 'THINK' %
05200 I←0; % INDEX INTO SET OF REPLIES %
05300 DELNO←0; % CURRENT DELUSION-NUMBER %
05400 FLARE←'INIT; % FLARE=CURRENT FLARE TOPIC;
05500 'INIT = NONE %
05600 LIVEFLARES←GET ('FLARELIST, 'SETS); % FLARES NOT YET DISCUSSED %
05700 SENSITIVELIST←GET ('SENSITIVELIST, 'SETS); % SENSITIVE TOPICS %
05800 DELNLIST←GET ('DELWDS, 'NOUNS); % DELUSION TOPICS %
05900 DELVLIST←GET ('DELWDS, 'VERBS);
06000 DELALIST←GET ('DELWDS, 'AMBIG); % DELUSION TOPICS ABOVE A CERTAIN THRESHOLD OF MISTRUST %
06100
06200 % DLIM IS THE NUMBER OF "MORE GENERAL" DELUSIONS
06300 CURRENTLY IN THE PROGRAM %
06400
06500 DLIM←6;
06600
06700 % LASTTOP = LAST MAIN SELF-TOPIC DISCUSSED AND NOT LEFT;
06800 QWORD = PRESENT OR MOST RECENT KEYWORD TOPIC %
06900
07000 LASTTOP←QWORD←'INTROTOP;
07100 TERPRI NIL;
07200 PRINTSTR ("END INPUT PARAMETERS WITH CARRIAGE RETURN OR ALTMODE");
07300 TERPRI NIL;
07400 PRINTSTR ("SUPPRESS NON VERBAL FEATURE? [Y,N]");
07500 SUPPRESS←IF READ () = 'Y THEN T ELSE NIL;
07600 TERPRI NIL;
07700 % COMMENT - TO RESTORE WEAK VERSION, JUST REMOVE FIRST
07800 PRINTSTR ("VERSION [WEAK, STRONG]");
07900 IF READ () EQ 'WEAK THEN
08000 BEGIN
08100 WEAK←T;
08200 ANGER←ANGER0←FEAR←FEAR0←MISTRUST←MISTRUST0←0;
08300 END
08400 ELSE
08500 BEGIN
08600 TERPRI NIL;
08700 AND LAST LINES OF THIS COMMENT AND DONT FORGET `END' BELOW %
08800 PRINTSTR ("ANGER [LOW, MILD]");
08900 ANGER←(ANGER0←IF READ () = 'LOW THEN 0 ELSE 10);
09000 TERPRI NIL;
09100 PRINTSTR ("FEAR [LOW, MILD]");
09200 FEAR←(FEAR0←IF READ () = 'LOW THEN 0 ELSE 10);
09300 TERPRI NIL;
09400 PRINTSTR ("MISTRUST [MILD, HIGH]");
09500 MISTRUST←(MISTRUST0←IF READ () EQ 'MILD THEN 0 ELSE 15);
09600 % END; %
09700 TERPRI NIL;
09800 PRINTSTR ("TRACE VARIABLES? [Y,N]");
09900 IF READ () = 'Y THEN TRACEV←T;
10000
10100 EOF←PERCENT;
10200 PRINTSTR TERPRI "ARE TWO TELETYPES BEING USED? (Y,N)";
10300 IF READ () EQ 'Y THEN
10400 BEGIN
10500 TALK←T;
10600 PRINTSTR TERPRI "WHAT DISK FILE DO YOU WANT THIS INTERVIEW SAVED ON? (5 LETTERS ONLY)";
10700 FILE1 ← READ() CONS 'DIA;
10800 FILE2 ← AT(SUBSTR(FILE1,1,5) CAT "A") CONS 'DIA; % OUTPUT ALTERNATES BETWEEN THESE TWO. %
10900 OUT(FILE1, NIL, T); % INITIALIZATION %
11000 END
11100 ELSE
11200 BEGIN
11300 SAVE_FILE ← T;
11400 EVAL '(INPUT (4 KMC) (PAR.FIL));
11500 INC(T,NIL);
11600 FILE1←AT("X" CAT (I←READ()));
11700 INC(NIL,T);
11800 EVAL '(OUTPUT (4 KMC) (PAR.FIL));
11900 OUTC(T,NIL);
12000 PRINT(I+1);
12100 OUTC(NIL,T);
12200 OUT(FILE1 CONS 'DIA, NIL, T);
12300 FILE2←AT(FILE1 CAT "A") CONS 'DIA;
12400 FILE1←FILE1 CONS 'DIA;
12500 END;
12600
12700 END;
12800
12900
13000 %
13100 ANGERMODE PROVIDES RESPONSES FOR HIGH ANGER LEVEL %
13200
13300 EXPR ANGERMODE ();
13400 IF ANGER GREATERP 17.5 THEN PROG2 (TERPRI NIL, SAY (CHOOSE ('ANGER)))
13500 ELSE PROG2 (TERPRI NIL, SAY (CHOOSE ('HOSTILEREPLIES)));
13600
13700 %
13800 CHECKFLARE SCANS THE INPUT SENTENCE FOR THE FLARE WORD WHICH HAS THE
13900 HIGHEST WEIGHT %
14000
14100 EXPR CHECKFLARE (INP, FLARELIST);
14200 BEGIN
14300 NEW NFLARE, WORD, FSET, WT, RESULT;
14400
14500 % DISTINGUISH FLARES FOUND WITHIN THE STATEMENT (NFLARE)
14600 FROM MOST RECENT FLARE (FLARE) %
14700
14800 NFLARE←'INIT; % GET ('INIT, 'WT) = 0 %
14900
15000 % SCAN INPUT FOR FLARES AND CHECK WHETHER WEIGHT IS
15100 GREATER THAN ANY PRECEDING FLARES IN INPUT %
15200
15300 FOR WORD IN INP DO
15400 IF (FSET←GET (WORD, 'SET)) MEMBER (FLARELIST) THEN
15500 IF (WT←GET (FSET, 'WT)) GREATERP GET (GET (NFLARE, 'SET), 'WT) THEN
15600 PROG2 (NFLARE←WORD, RESULT←T);
15700 IF RESULT THEN
15800
15900 % IF FLARE ALREADY BEING DISCUSSED, DISREGARD ANY
16000 VERY WEAK NEW FLARE %
16100
16200 IF NOT (FLARE = 'INIT) AND NOT ((WT←GET (GET (NFLARE, 'SET), 'WT)) GREATERP 1) THEN
16300 RESULT←NIL
16400 ELSE
16500 BEGIN
16600 FLARE←NFLARE;
16700 WEIGHT←WT; % USED IN COMPUTING RISE IN FEAR %
16800 END;
16900
17000 RETURN (RESULT);
17100
17200 END;
17300
17400 %
17500 DELREF SCANS THE INPUT SENTENCE FOR THE FIRST DIRECT REFERENCE TO 'SELF'S
17600 DELUSIONAL COMPLEX AND RETURNS A FEARFUL REACTION. IF NO SUCH REFERENCE
17700 IS FOUND, NIL IS RETURNED. %
17800
17900 EXPR DELREF (INP);
18000 BEGIN
18100 NEW WORD, FOUND;
18200 FOUND←DELCHECK (INP);
18300
18400 IF FOUND THEN
18500 BEGIN
18600 IF DELFLAG THEN
18700
18800 % IF DELUSIONS ALREADY BEING DISCUSSED, THEN
18900 DISTINGUISH BETWEEN "STRONG" AND "AMBIGUOUS" DELUSIONAL TOPICS
19000 IN COMPUTING RISE IN FEAR %
19100
19200 IF GET (CAR (FOUND), 'STRONG) THEN FJUMP←0.4
19300 ELSE FJUMP←0.2
19400 ELSE
19500 BEGIN
19600 FJUMP←0.5;
19700
19800 % 'MAFIA' TOPIC NO LONGEV INDUCES FEARFUL REACTION,
19900 SINCE DELUSION DISCUSSION HAS ALREADY BEEN EVOKED %
20000
20100 DELNLIST←DELETE ('MAFIA, DELNLIST);
20200
20300 % MODIFY FLARE STRUCTURES TO NOTE THAT 'MAFIA' TOPIC
20400 HAS ALREADY BEEN BROUGHT UP %
20500
20600 FLMOD ('MAFIASET);
20700 END;
20800
20900 % SET (OR KEEP) DELUSION FLAG = T UNLESS 'SELF HAS
21000 FINISHED DISCUSSION DELUSIONS %
21100
21200 IF NOT DELEND THEN DELFLAG←T;
21300
21400 % RESET SO THAT FLARES OF LOWER PRIORITY THAN THOSE WHICH
21500 MAY HAVE BEEN PREVIOUSLY MENTIONED ARE RECOGNIZED %
21600
21700 FLARE←'INIT;
21800 SAY (DELSTMT ());
21900
22000 % FORGET ABOUT RECENTLY DISCUSSED SELF-TOPICS %
22100
22200 LASTTOP←QWORD←'INTROTOP;
22300 END
22400 ELSE
22500 IF ('MAFIA % I.E. AS ALREADY USED DEL WD %
22600 MEMBER INP) THEN
22700
22800 % IF 'OTHER WANTS TO TALK ABOUT 'MAFIA' AFTER 'SELF HAS
22900 FINISHED DISCUSSING DELUSIONS, REJECT TOPIC %
23000
23100 IF DELEND THEN SAY (FOUND←CHOOSE ('MAFIASET))
23200 ELSE SAY (FOUND←DELSTMT ());
23300 RETURN (FOUND);
23400 END;
23500
23600 %
23700 DELSTMT CAUSES THE "NEXT" DELUSION TO BE EXPRESSED %
23800
23900 EXPR DELSTMT ();
24000 BEGIN
24100 NEW STMT; SPECIAL STMT;
24200
24300 % IN WEAK VEVSION, TALK ABOUT RACKETS RATHER THAN MAFIA %
24400
24500 IF WEAK THEN RETURN FLSTMT ('RACKETSET);
24600
24700 % IF 'SELF HAS ALREADY EXPRESSED ALL HIS DELUSIONS, HE REFERS TO
24800 PREVIOUSLY MENTIONED ONES UP TO 3 TIMES TOTAL %
24900
25000 IF DELNO = DLIM THEN DELNO←1
25100 ELSE DELNO←DELNO + 1;
25200 IF (FEAR GREATERP 18) OR (ANGER GREATERP 18) OR ((FEAR+ANGER+MISTRUST) GREATERP 50) THEN
25300 RETURN (PROG2 (DELFLAG←NIL, CHOOSE ('CHANGESUBJ)));
25400 DELFLAG←T;
25500 FLARE←'INIT;
25600
25700 % SELECT DELUSION %
25800
25900 STMT←CHOOSEDEL (DELNO);
26000
26100 % IF STMT CONTAINS DELUSIONAL FLARE, DELETE AS SUCH %
26200
26300 DELCHECK (STMT);
26400
26500
26600 % REMEMBER THE DELUSIONAL STATEMENT TO WHICH 'OTHER IS ABOUT TO RESPOND %
26700
26800 LASTSTMT←AT ("DEL" CAT DELNO);
26900 RETURN (STMT);
27000 END;
27100
27200 %
27300 DELTALK PRODUCES RESPONSE OF 'SELF IN CONTEXT OF EXPRESSION OF DELUSIONS %
27400
27500 EXPR DELTALK (STMT);
27600 IF NOT SKEP THEN
27700
27800 % NO LOCAL CONTEXT OF SKEPTICISM %
27900
28000 IF MEMBER1 (GET ('DISBELIEF, 'IND), STMT) THEN
28100
28200 % 'OTHER EXPRESSES DISBELIEF OF 'SELF'S DELUSIONS %
28300
28400 BEGIN
28500 AJUMP←0.3;
28600 FJUMP←0.1;
28700 SAY (CHOOSE ('BELIEVEREPLIES));
28800 SKEP←T;
28900 END
29000
29100 % CHECK FOR SPECIFIC QUESTION ABOUT DELUSIONS
29200 OR OTHER QUESTIONS %
29300
29400 ELSE SPECQUES (STMT) OR SAY (ANSWER (STMT))
29500 ELSE
29600 BEGIN
29700
00100 % IF FOLLOW-UP TO SKEPTICAL REMARK IS REASSURANCE,
00200 CONTINUE EXPRESSING DELUSIONS %
00300
00400 IF YES (STMT) THEN SAY (DELSTMT ())
00500 ELSE SAY (DISTRUST ());
00600 SKEP←NIL;
00700 END;
00800
00900 %
01000 FEARMODE PROVIDES FEARFUL REACTIONS TO STATEMENTS OF 'OTHER %
01100
01200 EXPR FEARMODE ();
01300 BEGIN
01400 TERPRI NIL;
01500 IF FEAR GREATERP 18.4 THEN SAY ('((EXITS)))
01600
01700 % DISTINGUISH BETWEEN QUESTIONS AND STATEMENTS OF 'OTHER %
01800
01900 ELSE QTHREAT (REMARK) OR SAY (CHOOSE ('AFRAID));
02000 END;
02100
02200 %
02300 FLAREREF HANDLES FLARE REFERENCES %
02400
02500 EXPR FLAREREF (INP);
02600 BEGIN
02700
02800 % CHECK FOR NEW FLARE AND RECORD AS "OLD" %
02900
03000 IF CHECKFLARE (INP, LIVEFLARES) THEN FLRECORD (GET (FLARE, 'SET));
03100
03200 % CHECK FOR OLD FLARE %
03300
03400 IF CHECKFLARE (INP, DEADFLARES) THEN
03500
03600 % RESPOND TO FLARE %
03700
03800 RETURN PROG2 (SAY (FLTALK (GET (FLARE, 'SET), 'Q CONS GET (FLARE, 'SET) CONS INP)), T);
03900 END;
04000
04100 %
04200 FLTALK %
04300
04400 EXPR FLTALK (FLSET, INP);
04500 IF FEAR GREATERP 17 OR ANGER GREATERP 17 THEN
04600 PROG2 (FLARE←'INIT, CHOOSE ('CHANGESUBJ))
04700
04800 % TRY TO ANSWER QUESTION ABOUT FLARE %
04900
05000 ELSE ANSWER (INP);
05100
05200 %
05300 IYOUME HANDLES INTERPERSONAL ATTITUDE STATEMENTS
05400
05500 THIS IS AN UNINTELLIGIBLE TEMPORARY ROUTINE WHICH REPRESENTS
05600 EXPERIMENTAL EFFORTS TO DISCOVER THE CASES WHICH MUST BE
05700 DISTINGUISHED IN DETERMINING THE MEANING OF THE INPUT %
05800
05900 EXPR IYOUME (INP);
06000 BEGIN
06100 NEW S, WD, SACT, ATTITUDE, AWORD, NWORDS, COUNT, REPLY;
06200 SPECIAL REPLY;
06300 TVAL←T;
06400 NWORDS←0;
06500
06600 % COLLECT RELEVANT ITEMS IN INPUT %
06700
06800 FOR WD IN INP DO
06900 IF WD EQ 'YOU OR WD EQ 'I OR WD EQ 'ME THEN PROG2 (S←WD CONS S, IF ATTITUDE THEN COUNT←NIL)
07000 ELSE
07100 IF WD MEMBER NLIST THEN TVAL←NOT TVAL
07200 ELSE
07300 IF WD MEMBER SACTS AND NOT SACT THEN
07400 PROG2 (SACT←WD CONS S, S←SUFLIST (S,2))
07500 ELSE
07600 IF NOT ATTITUDE AND ATTITUDE←GET (WD, 'ATTIT) THEN
07700 BEGIN
07800 S←(AWORD←WD) CONS S;
07900 NWORDS←0;
08000 COUNT←T;
08100 END
08200 ELSE
08300 IF COUNT THEN NWORDS←NWORDS + 1
08400 UNTIL LENGTH S = 3;
08500
08600 % TRANSFORM E.G. (I BELIEVE) (YOU) INTO (I BELIEVE YOU) %
08700
08800 IF SACT AND LENGTH S LESSP 2 THEN
08900 IF NOT ATTITUDE AND (ATTITUDE←GET (AWORD←CAR SACT, 'ATTIT)) THEN
09000 S←S @ SACT
09100 ELSE RETURN NIL;
09200
09300 % CHECK NO. OF WORDS BETWEEN ATTITUDE AND OBJECT %
09400
09500 IF NWORDS GREATERP 3 THEN RETURN NIL;
09600 IF GET (AWORD, 'NEG) THEN TVAL←NOT TVAL;
09700
09800 % CHECK FOR GENERAL ATTITUDE, E.G. (YOU ANGRY) %
09900
10000 IF LENGTH S LESSP 3 THEN
10100 IF S[2] EQ 'YOU AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND NOT GET (AWORD, 'RELN) THEN
10200 IF CAR INP EQ 'Q THEN PROG2 (INTERPERS←T, REPLY←ANSWER (INP))
10300 ELSE REPLY←CHOOSE ('SEEM)
10400 ELSE RETURN NIL
10500 ELSE
10600
10700 % CHECK FOR "YOU <ATTITUDE> ME" SITUATIONS %
10800
10900 IF S[3] EQ 'YOU AND S[2] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND S[1] EQ 'ME OR
11000 S[3] EQ 'I AND GET (S[2], 'FLIP) AND S[1] EQ 'YOU OR
11100 S[3] EQ 'I AND S[2] EQ 'YOU AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) THEN
11200 IF NOT GET (AWORD, 'RELN) OR CAR S EQ 'ME THEN
11300 REPLY←CHOOSE (IF TVAL THEN ATTITUDE CONS 'YMREPLIES ELSE GET (ATTITUDE, 'OPP) CONS 'YMREPLIES)
11400 ELSE NIL
11500 ELSE
11600
11700 % CHECK FOR "I <ATTITUDE> YOU" SITUATIONS %
11800
11900 IF S[3] EQ 'I AND S[2] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND S[1] EQ 'YOU OR
12000 S[3] EQ 'YOU AND GET (S[2], 'FLIP) AND S[1] EQ 'ME OR
12100 S[3] EQ 'YOU AND S[2] EQ 'ME AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) THEN
12200
12300 % TREAT REFERENCES TO SELF'S OPINION SIMILARLY TO AFFIRMATIVE
12400 STATEMENTS BY THE OTHER, AS FAR AS SELF'S ANSWER IS CONCERNED %
12500
12600 IF (CAR INP EQ 'Q OR SACT) AND CAR LAST SACT EQ 'YOU OR TVAL THEN
12700 REPLY←CHOOSE (ATTITUDE CONS 'IYREPLIES)
12800 ELSE
12900 BEGIN
13000 REPLY←CHOOSE (GET (ATTITUDE, 'OPP) CONS 'IYREPLIES);
13100 FJUMP←0.1;
13200 AJUMP←0.2;
13300 END;
13400 IF REPLY THEN RETURN PROG2 (SAY (REPLY), T);
13500 END;
13600
13700 %
13800 NORMAL HANDLES STATEMENT OF 'OTHER IN THE ABSENCE OF
13900 PROVOCATIVE INPUT %
14000
14100 EXPR NORMAL (STATEMENT);
14200 IF FEAR GREATERP 14 THEN FEARMODE ()
14300 ELSE
14400 IF ANGER GREATERP 14 THEN ANGERMODE ()
14500 ELSE
14600 IF DELFLAG THEN DELTALK (STATEMENT)
14700 ELSE
14800 PROMPT (STATEMENT);
14900
15000 %
15100 PERSREL %
15200
15300 EXPR PERSREL (INP);
15400 IYOUME (INP) OR APOLOG (INP) OR THREAT (INP);
15500
15600 %
15700 SELFREF SCANS THE INPUT SENTENCE FOR DIRECT OR INDIRECT REFERENCE TO THE SENSITIVE
15800 AREAS OF 'SELF AND CALLS FOR THE APPROPRIATE REPLY. IF NO SELF-REFERENCE
15900 IS PERCEIVED, NIL IS RETURNED. %
16000
16100 EXPR SELFREF (INP);
16200 BEGIN
16300 NEW YOU, NEG, FOUND, ADJ, CONCEPT, WORD;
16400
16500 % CHECK FOR DIRECT REFERENCE TO 'SELF %
16600
16700 IF ('YOU MEMBER INP) OR ('YOUR MEMBER INP) OR ('YOU?'RE MEMBER INP) THEN YOU←T;
16800
16900 % CHECK FOR EXPLICIT NEGATORS %
17000
17100 IF MEMBER1 (NLIST, INP) THEN NEG←T;
17200
17300 % CHECK FOR GENERAL INSULTS OR COMPLIMENTS %
17400
17500 FOR WORD IN INP DO
17600
17700 % CHECK 'YOU-NEGATION-INSULT' COMBINATIONS %
17800
17900 FOUND←IF WORD MEMBER GET ('INSULT, 'IND) THEN
18000 IF YOU THEN
18100 IF NOT NEG THEN PROG2 (AJUMP←0.8, CHOOSE ('ANGER))
18200 ELSE
18300 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.2, CHOOSE ('DISTANCE))
18400 ELSE PROG2 (AJUMP←0.3, CHOOSE ('PERS))
18500 ELSE
18600
18700 % CHECK 'YOU-NEGATION-COMPLIMENT' COMBINATIONS %
18800
18900 IF WORD MEMBER GET ('COMPL, 'IND) THEN
19000 IF YOU THEN
19100 IF NOT NEG THEN
19200 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.2,
19300 CHOOSE ('DISTANCE))
19400 ELSE
19500 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
19600 ELSE PROG2 (AJUMP←0.5, CHOOSE ('SENSREPLIES) @ (WORD CONS '(??)))
19700 UNTIL FOUND;
19800
19900 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T));
20000
20100 % CHECK FOR POSITIVE OR NEGATIVE REFERENCE TO 'SELF IN SENSITIVE AREA %
20200
20300 ADJ←ADJTYPE (INP); % DETERMINE PRESENCE OF POS OR NEG ADJECTIVE %
20400 FOR WORD IN INP DO
20500
20600 % 'SPECIAL DENOTES PERSONAL SENSITIVE AREA, E.G. APPEARANCE %
20700
20800 IF (CONCEPT←GET (WORD, 'SET)) MEMBER SENSITIVELIST THEN
20900 FOUND←IF (NOT GET (CONCEPT, 'SPECIAL)) AND (CAR (INP) EQ 'Q) AND YOU THEN
21000 PROG2 (AJUMP←0.2, ANSWER (INP))
21100 ELSE
21200 IF YOU AND (GET (ADJ, 'TYPE) EQ 'NEG) THEN
21300 IF NOT NEG THEN
21400 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
21500 ELSE
21600 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.3, CHOOSE ('DISTANCE))
21700 ELSE
21800 IF YOU AND (GET (ADJ, 'TYPE) EQ 'POS) THEN
21900 IF NOT NEG THEN
22000 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.3,
22100 CHOOSE ('DISTANCE))
22200 ELSE
22300 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
22400 ELSE
22500 IF YOU AND (GET (CONCEPT, 'SPECIAL) OR GET (ADJ, 'TYPE)) THEN
22600 BEGIN
22700 AJUMP←0.5;
22800 CONCEPT←<CONCEPT>;
22900 RETURN (CHOOSE ('DEFENSREPLIES) @ CONCEPT);
23000 END
23100 ELSE
23200 IF GET (ADJ,'TYPE) THEN
23300 PROG2 (AJUMP←0.5, SELFREFREPLY (ADJ, WORD))
23400 ELSE
23500 IF GET (CONCEPT, 'SPECIAL) THEN
23600 PROG2 (AJUMP←0.4, CHOOSE ('PERS))
23700 ELSE
23800 BEGIN
23900 AJUMP←0.2;
24000 CONCEPT← <CONCEPT>;
24100 RETURN (CHOOSE ('GUARD) @ CONCEPT);
24200 END
24300 ELSE NIL
24400 UNTIL FOUND;
24500 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T));
24600 END;
24700
24800 % 'TALK' ROUTINES FOR TWO TELETYPES %
24900
25000
25100 FEXPR OUT (L); % L = (DESTINATION FUNCTION OPEN CLOSE) %
25200 IF L[1] EQ 'DOC THEN SEND_MAIL('DOCJOB, L[2]) ELSE
25300 IF L[1] EQ 'OWN THEN EVAL L[2]
25400 ELSE BEGIN
25500 IF LENGTH L ≥ 3 & L[3] THEN EVAL <'OUTPUT, '(4 KMC), EVAL L[1]>;
25600 OUTC(T, NIL);
25700 EVAL L[2];
25800 OUTC(NIL, IF LENGTH L = 4 THEN L[4] ELSE NIL);
25900 END;
26000
26100 FEXPR INP (L); % L = (SOURCE FUNCTION) %
26200 IF L[1] EQ 'DOC THEN SEND_MAIL('DOCJOB, <'SEND_MAIL, '(QUOTE HAR000), L[2]>) ALSO WAIT_FOR_MAIL(L[3])
26300 ELSE EVAL L[2];
26400
26500 EXPR READ_MESSAGE ();
26600 BEGIN NEW L;
26700 PRINTSTR "READY:";
26800 TERPRI TERPRI DO NIL UNTIL CAR(L ← READCH() CONS L) EQ ALTMODE & CADR L EQ ALTMODE;
26900 RETURN REVERSE CDDR L
27000 END;
27100
27200 EXPR PRINT_MESSAGE (MESSAGE); TERPRI TERPRI FOR NEW CH IN MESSAGE DO PRINC CH;
27300
27400 EXPR PRINT_ALL (FILE); % COPIES FILE "FILE" TO THE CURRENTLY OPEN OUTPUT FILE. %
27500 BEGIN NEW CH;
27600 EVAL <'INC, <'INPUT, '(4 KMC), FILE>, NIL>;
27700 DO NIL UNTIL TYO TYI() EQ OCTAL 45 & (ATOM(CH ← ERRSET(READCH(),T)) | PRINC CAR CH & NIL);
27800 INC(NIL,T)
27900 END;
00100
00200 % ***** AUXILIARY FUNCTIONS ***** %
00300
00400
00500 %
00600 ADJTYPE RETURNS AND TRIES TO IDENTIFY ANY VALUE-TYPE MODIFIERS IN STATEMENT %
00700
00800 % TO BE REWRITTEN %
00900
01000 EXPR ADJTYPE (STMT);
01100 BEGIN
01200 NEW WORD, TYPE, FOUND;
01300 FOR WORD IN STMT DO
01400 FOR TYPE IN '(POS NEG AMBIG) DO
01500 IF WORD MEMBER GET ('ADJLIST, TYPE) THEN
01600 FOUND←PROG2 (PUTPROP (WORD, TYPE, 'TYPE), WORD)
01700 UNTIL FOUND
01800 UNTIL FOUND;
01900 RETURN (WORD);
02000 END;
02100
02200 %
02300 ANSVAR ALTERNATIVELY SELECTS ONE OF TWO VARIANTS OF AN ANSWER %
02400
02500 EXPR ANSVAR (KEYWD);
02600 BEGIN
02700 NEW A;
02800 IF NULL A←GET (KEYWD, 'A) THEN RETURN
02900 IF FLARE EQ 'INIT THEN CHOOSE ('EXHAUST)
03000 ELSE FLSTMT (GET (FLARE, 'SET))
03100 ELSE
03200 IF NOT ATOM CAR A THEN
03300
03400 % 'A' CONSISTS OF A LIST OF 2 ANSWERS: ((---)(---))
03500 RATHER THAN OF AN ANSWER: (---) %
03600
03700 RETURN CHOOSE (KEYWD CONS 'A)
03800 ELSE RETURN A;
03900 END;
04000
04100 %
04200 ANSWER HANDLES QUESTIONS OF 'OTHER:
04300 IF NO RECOGNIZED TOPIC ABOUT 'SELF IS BEING CONTINUED AND NO REFERENCE
04400 TO 'SELF IS DETECTED, THE QUESTION IS TREATED AS MISCELLANEOUS;
04500 OTHERWISE AN ANSWER TO THE QUESTION IS ATTEMPTED %
04600
04700 EXPR ANSWER (Q);
04800 BEGIN
04900 NEW ANS, WORD, CONCEPT;
05000
05100 SPECIAL ANS, QWORD;
05200
05300 % "INTERROGATIVE IMPERATIVES" ARE CONSIDERED AS QUESTIONS ABOUT 'SELF %
05400
05500 IF ('TELL MEMBER Q) THEN
05600 Q←('Q CONS 'YOU CONS Q)
05700 ELSE
05800
05900 % STATEMENTS THAT THE 'OTHER HAS A QUESTION ARE CONSIDERED AS QUESTIONS %
06000
06100 IF MEMBER1 (GET ('QUES, 'IND), Q) THEN
06200 Q←'Q CONS 'QUESTION CONS Q
06300 ;
06400
06500 % IF INPUT IS A QUESTION AND NO TOPIC IS CURRENTLY UNDER DISCUSSION
06600 AND INPUT REFERS TO SELF, EXPECT ONLY QUESTIONS RELATING
06700 TO A MAIN "SELF-TOPIC" %
06800
06900 IF CAR Q EQ 'Q AND QWORD EQ 'INTROTOP AND ('YOU MEMBER Q OR 'YOUR MEMBER Q OR 'SIE MEMBER Q) THEN
07000 ANS←ANSWER1 (Q, GET ('INTROTOP, 'Q))
07100 ELSE
07200
07300 % IF ALREADY ON SOME TOPIC, CHECK FIRST FOR NEW MAIN TOPIC,
07400 THEN FOR FOLLOW-UP TO LAST SUBTOPIC, THEN (UNLESS SUBTOPIC =
07500 MAIN TOPIC) FOR FOLLOW-UP TO LAST MAIN TOPIC %
07600
07700 IF QWORD NEQ 'INTROTOP THEN
07800 (IF MEMBER1 ('(YOU YOUR), Q) THEN ANS←ANSWER1 (Q, GET ('INTROTOP, 'Q))) OR (ANS←ANSWER2 (Q)) OR
07900 IF QWORD NEQ LASTTOP THEN ANS←PROG2 (QWORD←LASTTOP, ANSWER2 (Q))
08000 ;
08100 IF NOT ANS THEN
08200
08300 % NO QUESTIONS RECOGNIZED %
08400
08500 BEGIN
08600 ANS←IF CAR Q EQ 'Q THEN MISCQ (Q) ELSE MISCS (Q);
08700
08800 % REINITIALIZE TOPIC INDICATORS %
08900
09000 LASTTOP←QWORD←'INTROTOP;
09100 END;
09200 ASCAN (ANS, Q);
09300 RETURN (ANS);
09400 END;
09500 %
09600 ANSWER1 %
09700
09800 EXPR ANSWER1 (Q, TOPICS);
09900 BEGIN
10000 NEW CONCEPT, SPEC, ANS;
10100 SPECIAL ANS, QWORD;
10200 % TRY TO MATCH WORDS OF QUESTION WITH ONE OF THE SELF-TOPICS %
10300
10400 FOR CONCEPT IN TOPICS DO
10500 IF MEMBER1 (CONCEPT, Q) THEN
10600 BEGIN
10700
10800 % CHECK FOR SPECIFIC QUESTION ABOUT TOPIC
10900 MENTIONED IN THIS SENTENCE %
11000
11100 FOR SPEC IN GET (LASTTOP←CAR (CONCEPT), 'Q) DO
11200 IF MEMBER1 (SPEC, Q) THEN % QUESTION ABOUT MAIN TOPIC RECOGNIZED %
11300 ANS←ANSVAR (QWORD←CAR SPEC)
11400 UNTIL ANS;
11500
11600 IF NOT ANS THEN
11700
11800 % NO SPECIFIC QUESTION ABOUT THIS MAIN TOPIC RECOGNIZED %
11900
12000 BEGIN
12100
12200 % SAVE TOPIC KEY WORD %
12300
12400 QWORD←CAR (CONCEPT);
12500
12600 % GET ANSWER ASSCIATED WITH TOPIC KEY WORD %
12700
12800 ANS←ANSVAR (QWORD);
12900 END;
13000 END
13100 UNTIL ANS;
13200 RETURN (ANS);
13300 END;
13400 %
13500 ANSWER2 %
13600
13700 EXPR ANSWER2 (Q);
13800 BEGIN
13900 NEW CONCEPT, ANS;
14000 SPECIAL QWORD;
14100
14200 % CHECK FOR SPECIFIC QUESTION ABOUT TOPIC
14300 MENTIONED IN THE PRECEDING SENTENCE %
14400
14500 FOR CONCEPT IN GET (QWORD, 'Q) DO
14600 IF MEMBER1 (CONCEPT, Q) THEN
14700 ANS←ANSVAR (QWORD←CAR CONCEPT)
14800 UNTIL ANS;
14900 RETURN (ANS);
15000 END;
15100
15200 %
15300 APOLOG RESPONDS DIFFERENTIALLY TO APOLOGIES ACCORDING TO MISTRUST LEVEL %
15400
15500 EXPR APOLOG (STMT);
15600 IF MEMBER1 (GET ('APOL, 'IND), STMT) THEN
15700 BEGIN
15800 IF MISTRUST GREATERP 9 THEN
15900 AJUMP←0.2
16000 ELSE ANGER ← ANGER-1;
16100 SAY (CHOOSE ('ACCUSE));
16200 RETURN (T);
16300 END;
16400
16500 %
16600 ASCAN SCANS 'SELF'S ANSWER FOR MENTION OF FLARE OR MAFIA %
16700
16800 EXPR ASCAN (ANS, Q);
16900 BEGIN
17000 IF CHECKFLARE (ANS, LIVEFLARES) THEN FLMOD (GET (FLARE, 'SET));
17100 IF 'MAFIA MEMBER ANS THEN
17200 BEGIN
17300 DELFLAG←T;
17400 FLARE←'INIT;
17500 END;
17600 END;
17700
17800 %
17900 BADINP %
18000
18100 EXPR BADINP (SENT);
18200 BEGIN
18300 TERPRI NIL;
18400 IF '?: ε SENT THEN
18500 RETURN (PROG2 (PRINTSTR (STRINGATE (SENT)), T));
18600 END;
18700
18800 %
18900 BLANKSKIP RETURNS THAT PART OF SENTENCE FOLLOWING ANY SEQUENCE OF LEADING BLANKS,
19000 CARRIAGE RETURNS OR LINE FEEDS %
19100
19200 EXPR BLANKSKIP (SENT);
19300 IF NULL SENT THEN NIL
19400 ELSE
19500 IF CAR SENT EQ BLANK OR CAR SENT EQ CR OR CAR SENT EQ LF THEN BLANKSKIP (CDR SENT)
19600 ELSE SENT;
19700
19800 %
19900 CHOOSE SELECTS THE NEXT REPLY FROM THE RELEVANT GROUP %
20000
20100 EXPR CHOOSE (REPLIES);
20200 BEGIN
20300 NEW REPLY, RESPONSES, IND;
20400 SPECIAL ENDE;
20500 IF NOT ATOM REPLIES THEN
20600 BEGIN
20700 IND←CDR REPLIES;
20800 REPLIES←CAR REPLIES;
20900 END
21000 ELSE IND←'IND;
21100 IF NULL RESPONSES←GET (REPLIES, IND) THEN
21200 RETURN
21300 IF REPLIES EQ 'EXHAUST THEN PROG2 (ENDE←T, '((FED UP)) )
21400 ELSE PROG2(CONCEPT←NIL, CHOOSE ('EXHAUST));
21500 REPLY←CAR RESPONSES;
21600 PUTPROP (REPLIES, CDR RESPONSES, IND);
21700 RETURN REPLY;
21800 END;
21900
22000 %
22100 CHOOSEDEL CHOOSES A DELUSIONAL RESPONSE ACCORDING TO "TYPE", WHICH INDICATES
22200 WHETHER THE NEXT GENERAL DELUSION IS TO BE SELECTED (TYPE=NUMBER)
22300 OR A CERTAIN TYPE OF QUESTION IS TO BE ANSWERED %
22400
22500 EXPR CHOOSEDEL (TYPE);
22600 BEGIN
22700 NEW DEL, REPLY, FREQ, OLDF;
22800 IF NUMBERP (TYPE) THEN
22900 DEL←AT ('DEL CAT TYPE)
23000 ELSE DEL←TYPE;
23100 REPLY←IF (OLDF←GET (DEL, 'FREQ)) LESSP 3 THEN
23200 BEGIN
23300 NEW DELN;
23400
23500 % RAISE FREQUENCY %
23600
23700 PUTPROP (DEL, FREQ←OLDF+1, 'FREQ);
23800 DELN←CAR (SUFLIST (GET ('DELUSIONS, DEL), FREQ-1));
23900 RETURN (IF (TYPE = 1) OR (TYPE = 4) THEN % FOR VARIATION ONLY %
24000 GET ('PREFACE, GET (DEL, 'FREQ)) @ DELN
24100 ELSE DELN);
24200 END
24300 ELSE
24400 % 'SELF HAS MENTIONED THIS DELUSION 3 TIMES %
24500 BEGIN
24600 DELFLAG←NIL;
24700 DELEND←T; % DELUSION-END FLAG %
24800 RETURN ('(LET?'S TALK ABOUT SOMETHING ELSE?- I?'VE GIVEN
24900 YOU SOME IDEA OF WHAT?'S GOING ON));
25000 END;
25100 RETURN (REPLY);
25200 END;
25300
25400 %
25500 DELCHECK RETURNS ANY NEW DELUSION-EXPRESSIONS FOUND IN INPUT AND DELETES AS SUCH %
25600
25700 EXPR DELCHECK (INP);
25800 BEGIN
25900 NEW WORDS;
26000
26100 % CHECK FOR STRONG DELUSION-NOUNS AND -VERBS
26200 (AT PRESENT THE NOUN-VERB DISTINCTION IS NOT UTILIZED %
26300
26400 IF WORDS←MEMBER1 (DELNLIST, INP) THEN
26500 DELNLIST←DELETE (WORDS, DELNLIST)
26600 ELSE
26700 IF WORDS←MEMBER1 (DELVLIST, INP) THEN
26800 DELVLIST←DELETE (WORDS, DELVLIST)
26900 ELSE
27000
27100 % CHECK FOR AMBIGUOUS DELUSION WORDS AT HIGH MISTRUST LEVEL %
27200
27300 IF MISTRUST GREATERP 10 AND WORDS←MEMBER1 (DELALIST, INP) THEN
27400 DELALIST←DELETE (WORDS, DELALIST)
27500 ;
27600 RETURN (IF WORDS AND ATOM WORDS THEN WORDS CONS NIL ELSE WORDS);
27700 END;
27800
27900
28000 %
28100 DELETE DELETES WORD WD FROM LIST L %
28200
28300 EXPR DELETE (WD, L);
28400 IF NULL L THEN NIL
28500 ELSE
28600 IF WD EQ CAR (L) THEN CDR (L)
28700 ELSE CAR (L) CONS DELETE (WD, CDR (L));
28800
28900 %
29000 DISTRUST HANDLES FOLLOW-UPS TO LOCAL SITUATIONS OF DISTRUST %
29100
29200 EXPR DISTRUST ();
29300 IF (FEAR GREATERP 10) OR (ANGER GREATERP 10) OR
29400 ((FEAR + ANGER) GREATERP 14) THEN
29500 CHOOSE ('TURNOFF)
29600 ELSE CHOOSE ('ALOOF);
29700
00100 %
00200 FIXPTRS TRANSFERS HIERARCHICAL POINTERS TO NEW FLARE
00300 TO NEXT HIGHER FLARE IN PATH %
00400
00500 EXPR FIXPTRS (FLSET);
00600 BEGIN
00700 NEW CONCEPT;
00800 FOR CONCEPT IN LIVEFLARES @ DEADFLARES DO
00900 IF GET (CONCEPT, 'NEXT) EQ FLSET THEN
01000 PUTPROP (CONCEPT, GET (FLSET, 'NEXT), 'NEXT);
01100 END;
01200
01300 %
01400 FLRECORD NOTES MENTION OF FLARE AND RAISES FEAR %
01500
01600 EXPR FLRECORD (FLSET);
01700 BEGIN
01800 FLMOD (FLSET);
01900 FJUMP←WEIGHT/40.0;
02000
02100 % REINITIALIZE SELF-TOPIC INDICATORS %
02200
02300 LASTTOP←QWORD←'INTROTOP;
02400 END;
02500
02600 %
02700 FLMOD MOVES NEW FLARE FROM "LIVELIST" TO "DEADLIST" AND
02800 ADJUSTS FLARE POINTER HIERARCHY %
02900
03000 EXPR FLMOD (FLSET);
03100 BEGIN
03200 LIVEFLARES←DELETE (FLSET, LIVEFLARES);
03300 DEADFLARES←(FLSET CONS DEADFLARES);
03400 FIXPTRS (FLSET);
03500 END;
03600
03700 %
03800 FLARELEAD DECIDES WHAT TYPE OF "SUSPICIOUSNESS" REPLY IS SUITED
03900 TO INTRODUCE THE FLARE CONCEPT %
04000
04100 EXPR FLARELEAD (FLSET);
04200 BEGIN
04300 IF GET (FLSET, 'TYPE) EQ 'INSTITUTION THEN
04400 RETURN (CHOOSE ('NEXTFL) @ '(THE) @
04500 <CAR (GET (FLSET, 'WORDS))>)
04600 ELSE
04700 RETURN (CHOOSE ('NEXTFL) @
04800
04900 % DO NOT TREAT SINGULARS AS A GENERIC TOPIC %
05000
05100 (IF CAR (LAST (EXPLODE (FLARE))) EQ 'S THEN <FLARE>
05200 ELSE <CAR (GET (FLSET, 'WORDS))>)
05300 );
05400 END;
05500
05600 %
05700 FLSTMT PROVIDES NEXT STATEMENT ABOUT FLARE %
05800
05900 EXPR FLSTMT (FSET);
06000
06100 % IF REACH 'MAFIASET THRU FLARE HIERARCHY, ENTER DELUSIONAL MODE %
06200
06300 IF (FSET EQ 'MAFIASET) AND NOT DELEND THEN
06400 PROG2 (DELFLAG←T, DELSTMT ())
06500 ELSE
06600 IF (NREF←GET (FSET, 'NREF)) LESSP 2 THEN
06700 BEGIN
06800 PUTPROP (FSET, NREF←(NREF+1), 'NREF);
06900
07000 % MAKE NEXT STATEMENT ABOUT CURRENT FLARE TOPIC %
07100
07200 RETURN (CAR (SUFLIST (GET (FSET, 'STMTS), NREF-1)));
07300 END
07400
07500 % GO TO NEXT FLARE TOPIC %
07600
07700 ELSE LEADON (GET (FSET, 'NEXT))
07800 ;
07900
08000 %
08100 JOIN INSERTS HYPHENS BETWEEN WORDS OF ONE CONCEPT TO
08200 MAKE ONE ATOM %
08300
08400 EXPR JOIN (?!L); READLIST(EXPLODEC(CAR(?!L)) @ JOIN1(CDR(?!L)));
08500
08600 EXPR JOIN1 (?!L); IF NULL ?!L THEN NIL ELSE DASH CONS EXPLODEC(CAR(?!L)) @ JOIN1(CDR(?!L));
08700
08800 %
08900 LEADON %
09000
09100 EXPR LEADON (NEWSET);
09200 BEGIN
09300 IF NEWSET NEQ 'MAFIASET THEN
09400
09500 % RECORD NEW FLARE %
09600
09700 BEGIN
09800 FLMOD (NEWSET);
09900 FLARE←CAR (GET (NEWSET, 'WORDS));
10000 END
10100 ELSE
10200 IF DELEND THEN
10300
10400 % ARRIVE AT 'MAFIASET BUT THROUGH WITH DELUSIONS %
10500
10600 RETURN (PROG2 (FLARE←'INIT, CHOOSE ('FEELER)))
10700 ELSE
10800 IF WEAK OR (FEAR GREATERP 17) OR (ANGER GREATERP 17) OR
10900 ((FEAR + ANGER + MISTRUST) GREATERP 40) THEN
11000
11100 % ARRIVED AT 'MAFIASET BUT DOES NOT HAVE DELUSIONS ABOUT
11200 MAFIA OR IS UNWILLING TO DISCUSS THEM %
11300
11400 RETURN (CHOOSE ('CHANGESUBJ))
11500 ELSE
11600 BEGIN
11700 DELETE ('MAFIA, DELNLIST);
11800 DELFLAG←T;
11900 FLARE←'INIT;
12000 END;
12100
12200 % RESPOND WITH NEW FLARE %
12300
12400 RETURN (FLARELEAD (NEWSET));
12500 END;
12600
12700 %
12800 MEMBER1 CHECKS WHETHER ATOMS OR GROUPS OF WORDS IN WLIST ARE PRESENT IN INPUT %
12900
13000 EXPR MEMBER1 (WLIST, SPECIAL INP);
13100 BEGIN
13200 NEW FOUND, GROUP;
13300 FOR GROUP IN WLIST DO
13400 FOUND←IF ATOM (GROUP) THEN GROUP MEMBER INP
13500 ELSE
13600 EVAL ('AND CONS MAPCAR (FUNCTION (LAMBDA (X); X MEMBER INP), GROUP))
13700 UNTIL FOUND;
13800 IF FOUND THEN RETURN GROUP;
13900 END;
14000
14100 %
14200 MISCQ TRIES TO DETECT AND ANSWER CERTAIN RECOGNIZABLE QUESTIONS.
14300 IF IT FAILS, IT TRIES TO DISCERN WHETHER THE QUESTION CONTAINS
14400 INTERROGATIVE WORDS REQUIRING A SPECIFIC ANSWER, OR WHETHER IT
14500 REQUIRES A GENERAL YES- OR NO-TYPE ANSWER,
14600 AND CALLS FOR AN APPROPRIATE REPLY %
14700
14800 EXPR MISCQ (Q);
14900 BEGIN
15000 NEW QWORD, ANS, CONCEPT;
15100 IF SUFLIST (Q, LENGTH Q - 3) = '(HOW ARE YOU) THEN ANS←'(ALL RIGHT)
15200 ELSE
15300
15400 % INTERPERSONAL ATTITUDE MAY HAVE BEEN SET IN IYOUME IN CONTEXT OF 'YOU <ATTITUDE>' %
15500
15600 IF INTERPERS THEN RETURN PROG2 (INTERPERS←NIL,
15700 IF MEMBER1 (GET ('QLIST, 'IND), Q) THEN CHOOSE ('WFEEL)
15800 ELSE CHOOSE ('QFEEL) )
15900 ELSE
16000
16100 % CHECK FOR QUESTION ABOUT EXTERNAL WORLD %
16200
16300 IF NOT (ANS←OBJQ (Q)) THEN
16400 IF 'HOW MEMBER Q THEN
16500
16600 % UNIDENTIFIABLE "HOW-TYPE" QUESTION %
16700
16800 FOR CONCEPT IN '(MANY MUCH LONG OFTEN) DO
16900 IF CONCEPT MEMBER Q THEN ANS←CHOOSE (CONCEPT)
17000 UNTIL ANS;
17100 IF ANS THEN RETURN (ANS)
17200 ELSE
17300
17400 % IF QUESTION NOT RECOGNIZED, TRY TO ANSWER ACCORDING TO CONTEXT %
17500
17600 IF FLARE NEQ 'INIT THEN RETURN FLSTMT (GET (FLARE, 'SET))
17700 ELSE
17800 IF DELFLAG THEN RETURN DELSTMT ()
17900 ELSE
18000
18100 % WH- QUESTIONS %
18200
18300 IF 'WHY MEMBER Q THEN ANS←CHOOSE ('WHY)
18400 ELSE
18500 FOR QWORD IN GET ('QLIST, 'IND) DO
18600 (ANS← IF QWORD MEMBER Q THEN CHOOSE ('UNKNOWN))
18700 UNTIL ANS;
18800 IF ANS THEN RETURN (ANS)
18900 ELSE
19000
19100 % MISCELLANEOUS "TELL-" QUESTION %
19200
19300 IF ('TELL MEMBER Q) THEN RETURN '(I DON?'T KNOW ANYTHING ABOUT THAT)
19400 ELSE
19500
19600 % NO CLUES - ANSWER NONCOMMITTALLY %
19700
19800 RETURN (CHOOSE ('QREPLIES));
19900 END;
20000
20100 %
20200 MISCS TRIES TO DETECT AND ANSWER CERTAIN RECOGNIZABLE STATEMENTS,
20300 MAINLY IMPERATIVES AND EXPECTED EXPRESSIONS %
20400
20500 EXPR MISCS (S);
20600 IF ('JUMP MEMBER S) THEN '((EXITS))
20700 ELSE
20800 IF (CAR (S) EQ 'HI) OR (CAR (S) EQ 'HELLO) OR (CAR (S) EQ 'HOWDY) OR
20900 CADR S MEMBER '(MORNING AFTERNOON EVENING) THEN '(HELLO)
21000 ELSE
21100 IF (('DOCTOR MEMBER S) OR ('DR MEMBER S)) OR
21200 (('MY MEMBER S) AND ('NAME MEMBER S)) THEN
21300 '(GLAD TO MEET YOU)
21400 ELSE
21500 IF (('ALREADY MEMBER S) OR ('BEFORE MEMBER S)) AND
21600 (('SAID MEMBER S) OR ('MENTIONED MEMBER S)) THEN
21700 '(I GUESS I DID)
21800 ELSE
21900
22000 % LOOK AT CONTEXT OF CONVERSATION %
22100
22200 IF FLARE NEQ 'INIT THEN FLSTMT (GET (FLARE, 'SET))
22300 ELSE
22400 IF DELFLAG THEN DELSTMT ()
22500
22600 % NONCOMMITTAL REPLY %
22700
22800 ELSE CHOOSE ('SREPLIES);
22900
23000 %
23100 MODIFVAR MODIFIES AFFECT VARIABLES AFTER EACH I-O PAIR %
23200
23300 EXPR MODIFVAR ();
23400 BEGIN
23500 RAISE ();
23600
23700 % ACCOUNT FOR NORMAL DROP IN EACH VARIABLE %
23800
23900 ANGER←IF ANGER GREATERP ANGER0 + 1 THEN ANGER - 1 ELSE ANGER0;
24000 IF DELFLAG THEN
24100
24200 % ADD 5 TO BASE VALUE OF FEAR IF DELUSIONS UNDER DISCUSSION %
24300
24400 FEAR←IF FEAR GREATERP FEAR0 + 5.1 THEN FEAR - 0.1 ELSE FEAR0 + 5
24500 ELSE
24600 IF FLARE NEQ 'INIT THEN
24700
24800 % ADD 3 TO BASE VALUE OF FEAR IF FLARES UNDER DISCUSSION %
24900
25000
25100 FEAR←IF FEAR GREATERP FEAR0 + 3.2 THEN FEAR - 0.2 ELSE FEAR0 + 3
25200 ELSE
25300 FEAR←IF FEAR GREATERP FEAR0 + 0.3 THEN FEAR - 0.3 ELSE FEAR0;
25400 MISTRUST←IF MISTRUST GREATERP MISTRUST0+0.05 THEN MISTRUST - 0.05 ELSE MISTRUST0;
25500 IF TRACEV THEN
25600
25700 % PRINT OUT VALUES OF VARIABLES %
25800
25900 BEGIN
26000 TERPRI NIL;
26100 PRINTSTR (" FEAR = " CAT FEAR);
26200 PRINTSTR (" ANGER = " CAT ANGER);
26300 PRINTSTR (" MISTRUST = " CAT MISTRUST);
26400 END;
26500 TERPRI NIL;
26600 END;
26700
26800 %
26900 NULLSKIP RETURNS THAT PART OF SENT FOLLOWYNG AN SEQUENCE OF
27000 BLANKS, CARRIAGE RETURNS, LINE FEEDS, COMMAS OR DASHES %
27100
27200 EXPR NULLSKIP (SENT);
27300 IF (CHAR←CAR SENT) EQ BLANK OR (CHAR EQ CR) OR (CHAR EQ LF) OR (CHAR EQ COMMA) OR (CHAR EQ DASH) THEN
27400 NULLSKIP (CDR SENT)
27500 ELSE SENT;
27600
27700 %
27800 OBJQ HANDLES "OBJECTIVE"-TYPE QUESTIONS
27900 (ABOUT LOCAL EXTERNAL WORLD) %
28000
28100 EXPR OBJQ (Q);
28200 BEGIN
28300 NEW PAIR, FOUND;
28400 IF (('WHAT MEMBER Q) OR ('WHO MEMBER Q) OR ('WHICH MEMBER Q)) AND
28500 FOR PAIR IN GET ('OBJDATA, 'IND) DO
28600 FOUND←IF <CAR (PAIR)> MEMBER1 Q THEN CADR (PAIR)
28700 UNTIL FOUND THEN
28800 RETURN (FOUND);
28900 END;
29000
29100 %
29200 PROMPT HANDLES "TELL-ABOUT-YOURSELF" QUESTIONS %
29300
29400 % TO BE REWRITTEN (KEN REWROTE THIS 11/4/71) %
29500
29600
29700 EXPR PROMPT (INP);
00100 IF MEMBER1 (GET ('DISCUSS, 'IND), INP) AND MEMBER1 (GET ('SELF, 'IND), INP) THEN
00200 BEGIN
00300 NEW ANS;
00400 INP←'TELL CONS INP;
00500 SAY (ANS←ANSWER1 (INP, GET ('INTROTOP, 'Q)));
00600 ASCAN (ANS, INP);
00700 END
00800 ELSE SAY (ANSWER (INP));
00900
01000 %
01100 QTHREAT RESPONDS SUSPICIOUSLY TO QUESTIONS AT HIGH FEAR LEVEL %
01200
01300 EXPR QTHREAT (STMT);
01400 IF CAR (STMT) EQ 'Q THEN PROG2 (SAY (CHOOSE ('THREATQ)), T)
01500 ;
01600
01700 %
01800 RAISE RAISES LEVEL OF RELEVANT AFFECT VARIABLES;
01900 REDUCE JUMP IF IN WEAK VERSION %
02000
02100 EXPR RAISE ();
02200 BEGIN
02300 IF FJUMP THEN
02400 BEGIN
02500 IF WEAK THEN FJUMP←0.3 * FJUMP;
02600 FEAR ← (FEAR + FJUMP * (20 - FEAR));
02700 MISTRUST ← (MISTRUST + (0.5 * FJUMP) * (20 - MISTRUST));
02800 MISTRUST0←MISTRUST0 + 0.1 * FJUMP * (20 - MISTRUST0);
02900 FJUMP←NIL;
03000 END;
03100 IF AJUMP THEN
03200 BEGIN
03300 IF WEAK THEN AJUMP←0.7 * AJUMP;
03400 ANGER ← (ANGER + AJUMP * (20 - ANGER));
03500 MISTRUST ← (MISTRUST + (0.5 * AJUMP) * (20 - MISTRUST));
03600 MISTRUST0←MISTRUST0 + 0.1 * AJUMP * (20 - MISTRUST0);
03700 AJUMP←NIL;
03800 END;
03900 END
04000 ;
04100
04200 %
04300 READSENT RETURNS SCANNED SENTENCE IN THE FORM OF A LIST OF WORDS %
04400
04500
04600 EXPR READSENT (SENT);
04700
04800 % SENT IS A LIST OF INPUT CHARACTERS %
04900
05000 BEGIN
05100 NEW CHAR;
05200 TERMIN←NIL;
05300
05400 % SKIP OVER LEADING CHARACTERS WHICH AREN'T LETTERS OR NUMBERS %
05500
05600 WHILE NOT (GET (CHAR←CAR SENT, 'LET) OR NUMBERP CHAR OR NULL SENT) DO SENT←CDR SENT;
05700 IF NULL SENT THEN TERMIN←'ILL
05800 ELSE RETURN READSENT1 (SCANWD (BLANKSKIP (SENT)));
05900 END;
06000
06100 %
06200 READSENT1 ASSEMBLES REMAINDER OF SENTENCE STARTING AT BEGINNING OF NEXT WORD %
06300
06400
06500 EXPR READSENT1 (WORD);
06600
06700 % WORD IS A LIST OF CHARACTERS COMPRISING 1 WORD AS DETERMINED BY SCANWD %
06800
06900 IF TERMIN THEN PROG2 (RESTSENT←NIL, IF TERMIN EQ 'ILL THEN NIL
07000 ELSE
07100 IF NULL WORD THEN NIL
07200 ELSE <READLIST (WORD)>)
07300 ELSE READLIST (WORD) CONS READSENT1 (SCANWD (RESTSENT));
07400
07500 %
07600 RTPAR ELIMINATES LEADING PARENTHETICAL EXPRESSIONS FROM 'S' %
07700
07800
07900 EXPR RTPAR (S, LENG);
08000 BEGIN
08100 NEW N;
08200 FOR N←1 TO LENG DO NIL
08300 UNTIL SUBSTR (S, N, 1) SEQ ")";
08400 RETURN (SUBSTR (S, N+1, 'ALL));
08500 END;
08600
08700 %
08800 SAY HANDLES OUTPUT OF LIST 'STMT' %
08900
09000 EXPR SAY (STMT);
09100 BEGIN
09200 NEW ESTMT,TEMP;
09300 STMT←STRINGATE (STMT);
09400
09500 % IN "SUPPRESS" OR "TALK" VERSION, ELIMINATE LEADING PARENTHETICAL EXPRESSIONS %
09600
09700 IF (SUPPRESS OR TALK) AND CAR (ESTMT←EXPLODEC STMT) EQ '?( THEN
09800 STMT←RTPAR (STMT, LENGTH ESTMT);
09900 OUT (OWN, PRINTSTR STMT);
10000 IF TALK THEN
10100 BEGIN NEW VALUES; SPECIAL VALUES;
10200 OUT (FILE1, PRINTSTR STMT);
10300 VALUES ← EVAL <'INP, 'DOC,
10400 <'PROG, '(X),
10500 <'PRINTSTR, <'QUOTE, AT STMT>>,
10600 '(PRINT (QUOTE RESPONSE?:)),
10700 '(CLEAR_BUFFER),
10800 '(SETQ X (READ)),
10900 '(PRINT (QUOTE PATIENT?:)),
11000 '(CLEAR_BUFFER),
11100 '(RETURN (LIST (QUOTE RESPONSE) X (QUOTE PATIENT) (TERPRI (TERPRI (READ)))))>, T>;
11200 OUT(FILE1, PROG2(PRINT VALUES, PRINC TERPRI EOF), NIL, T);
11300 SAVEJOB('HAR000,'SAV); % SAVE THE CORE IMAGE UNDER HAR000.SAV IN CASE THE SYSTEM GOES DOWN. %
11400
11500 % THIS IS THE POINT AT WHICH THE PROGRAM WILL START IF THE SYSTEM GOES DOWN. %
11600 TEMP ← FILE1;
11700 FILE1 ← FILE2;
11800 FILE2 ←TEMP;
11900 OUT (FILE1, PRINT_ALL( FILE2), T)
12000 END
12100 ELSE IF SAVE_FILE THEN
12200 BEGIN
12300λ
OUT(FILE1, PRINTSTR STMT);
12400 OUT(FILE1, PRINC TERPRI EOF, NIL, T);
12500 TEMP ← FILE1;
12600 FILE1 ← FILE2;
12700 FILE2 ← TEMP;
12800 OUT(FILE1, PRINT_ALL (FILE2),T)
12900 END
13000 END;
13100
13200 %
13300 SCANWD RETURNS NEXT WORD IN SENT AS LIST OF CHARACTERS %
13400
13500 EXPR SCANWD (SENT);
13600 BEGIN
13700 NEW CHAR;
13800 RETURN
13900 IF (CHAR←CAR SENT) EQ PERIOD OR CHAR EQ '?? THEN
14000
14100 % ILLEGAL FOR TERMINATOR TO BE FOLLOWED BY OTHER CHARACTERS %
14200
14300 PROG2 (TERMIN←IF NOT BLANKSKIP (CDR SENT) THEN CHAR ELSE 'ILL, NIL)
14400 ELSE
14500 IF CHAR EQ BLANK OR CHAR EQ CR OR CHAR EQ COMMA OR CHAR EQ DASH THEN
14600 PROG2 (RESTSENT←NULLSKIP (SENT), NIL)
14700 ELSE
14800 IF NUMBERP (CHAR) OR GET (CHAR, 'LET) THEN
14900 CHAR CONS SCANWD (CDR SENT)
15000 ELSE PROG2 (TERMIN←'ILL, NIL);
15100 END;
15200
15300 %
15400 SELFREFREPLY INTRODUCES VARIATION INTO CHOSEN "SENSITIVE" REPLY %
15500
15600 EXPR SELFREFREPLY (ADJ, NOUN);
15700 BEGIN
15800 NEW REPLY;
15900 FLAG←NOT (FLAG);
16000 REPLY←CHOOSE ('SENSREPLIES) @
16100 (IF FLAG THEN <ADJ> ELSE <ADJ, NOUN>)
16200 @ '(??);
16300 RETURN (REPLY);
16400 END;
16500
16600 %
16700 SENTYPE SETS UP TYPE OF SENTENCE (STATEMENT, QUESTION, ILLEGAL)
16800 TO RETURN FOR PROCESSING %
16900
17000
17100 EXPR SENTYPE (SENT);
17200 IF TERMIN EQ 'ILL THEN '(?: BAD INPUT?; TRY AGAIN?.)
17300 ELSE
17400 IF TERMIN = '?? THEN 'Q CONS SENT ELSE SENT;
17500
17600 %
17700 SPECQUES PROVIDES ANSWERS TO SPECIFIC QUESTIONS RELATED TO THE
17800 DELUSIONAL COMPLEX %
17900
18000 % TO BE REWRITTEN %
18100
18200 EXPR SPECQUES (INP);
18300 BEGIN
18400 NEW WORD, WD, FOUND, QA, PAIR, VALUE;
18500 QA←GET ('ANSWERS, LASTSTMT);
18600 IF QA THEN
18700 FOR PAIR IN QA DO
18800 FOUND←MEMBER1 (CAR (PAIR), INP)
18900 UNTIL FOUND;
19000 IF FOUND THEN
19100
19200 % FOUND KEY WORDS ASSOCIATED WITH LAST DELUSIONAL STATEMENT %
19300
19400 VALUE←BEGIN
19500 LASTSTMT←CADR (PAIR);
19600 RETURN (CHOOSEDEL (CADR (PAIR)));
19700 END;
19800 IF NOT VALUE THEN
19900
20000 % AT ANY POINT IN DELUSION DISCUSSION, IF 'WHO' IS NOT OTHERWISE RECOGNIZED,
20100 ASSUME AS REFERRING TO MAFIA %
20200
20300 IF ((WD←INP[2]) EQ 'WHO) OR (WD EQ 'WHOM) THEN VALUE←'(THE MAFIA);
20400 IF NOT FOUND THEN
20500 IF ('THEY MEMBER INP) AND (('DO MEMBER INP) OR ('ARE MEMBER INP)) AND (LENGTH (INP) LESSP 4)
20600 AND (CAR (INP) EQ 'Q) THEN
20700 VALUE←'(THAT?'S RIGHT);
20800 IF VALUE THEN
20900 BEGIN
21000
21100 % DELETE ANY NEW DELUSIONAL WORDS IN 'SELF'S STATEMENT
21200 FROM DELUSION LIST %
21300
21400 DELCHECK (VALUE);
21500 SAY (VALUE);
21600 END;
21700 RETURN (VALUE);
21800 END;
21900
22000 %
22100 SPECREAX PROVIDES THE APPROPRIATE REACTION OF 'SELF TO SPECIAL TYPES
22200 OF STATEMENT OF 'OTHER %
22300
22400 EXPR SPECREAX (STMT);
22500
22600 IF CAR STMT EQ 'S THEN
22700 PROG2 (SAY (CHOOSE ('SILENCE)), T)
22800 ELSE
22900 IF 'YOU MEMBER STMT AND MEMBER1 (GET ('ABNORMAL, 'IND), STMT) THEN
23000
23100 % INSINUATION THAT 'SELF IS MENTALLY ILL %
23200
23300 BEGIN
23400 IF CAR STMT EQ 'Q THEN FJUMP←(AJUMP←0.3)
23500 ELSE FJUMP←(AJUMP←0.5);
23600 SAY (CHOOSE ('ALIEN));
23700 RETURN T;
23800 END;
23900
24000 %
24100 SPLIT MAKES LIST OUT OF HYPHENATED WORDS OF AN ATOM %
24200
24300 EXPR SPLIT (JOIND);
24400 BEGIN
24500 NEW ?!LET, WD, LST;
24600 FOR ?!LET IN REVERSE (EXPLODEC (JOIND)) DO
24700 IF ?!LET = DASH THEN PROG2 (LST←READLIST (WD) CONS LST, WD←NIL)
24800 ELSE WD←?!LET CONS WD;
24900 RETURN (READLIST (WD) CONS LST);
25000 END;
25100
25200 %
25300 STRINGATE MAKES A STRING OUT OF A QUOTED LIST %
25400
25500 EXPR STRINGATE (L);
25600 FOR NEW WD IN L; CAT WD CAT " ";
25700
25800 %
25900 THREAT %
26000
26100 EXPR THREAT (STMT);
26200 BEGIN
26300 NEW FOUND;
26400 IF FOUND←MEMBER1 (GET ('DELWDS, 'NOUNS) @ GET ('DELWDS, 'VERBS), STMT) THEN
26500 IF MEMBER1 (NLIST, STMT) THEN
26600 BEGIN
26700 FEAR←FEAR-1;
26800 FOUND←CHOOSE ('CAUTION);
26900 END
27000 ELSE
27100 IF 'I MEMBER STMT THEN
27200 BEGIN
27300 FJUMP←0.5;
27400 FOUND←CHOOSE ('PANIC);
27500 END
27600 ELSE FOUND←NIL;
27700 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T))
27800 ELSE RETURN (NIL);
27900 END;
28000
28100 %
28200 YES SCANS STATEMENT OF 'OTHER FOR AFFIRMATIVE EXPRESSIONS %
28300
28400 % TO BE REWRITTEN %
28500
28600 EXPR YES (INP);
28700 IF GET ('BELIEVEREPLIES, 'IND) THEN
28800
28900 % POSITIVE ANSWER TO QUESTION IS AFFIRMATIVE--
29000 APPLIES TO ALL 'BELIEVEREPLIES USED EXCEPT LAST ONE ON LIST %
29100
29200 (NOT MEMBER1 (GET ('DISBELIEF, 'IND), INP)) AND NOT ('NO MEMBER INP) AND
29300 (('YES MEMBER INP) OR ('CERTAINLY MEMBER INP) OR
29400 ('GUESS MEMBER INP) OR ('SURE MEMBER INP))
29500 ELSE
29600
29700 % NEGATIVE ANSWER TO NEGATIVE STATEMENT IS AFFIRMATIVE %
00100
00200 (NOT MEMBER1 (GET ('DISBELIEF, 'IND), INP)) AND ('NO MEMBER INP)
00300 ;
00400
00500
00600
00700 % ***** MAIN PROGRAM ***** %
00800
00900
01000 INITIALIZE();
01100
01200 PRINTSTR "
01300 END INPUT WITH A PERIOD OR QUESTION MARK, FOLLOWED BY TWO ALTMODES.
01400 SPELL OUT NUMBERS.
01500 TO INDICATE SILENCE, TYPE 'S.'
01600 WHEN FINISHED, TYPE 'BYE.'
01700 ";
01800
01900
02000 WHILE NOT ENDE DO
02100 BEGIN NEW OK;
02200 INTERPERS←NIL; % REINITIALIZE INTERPERSONAL ATTITUDE %
02300 IF TALK THEN
02400 BEGIN
02500 IF ¬JOB_EXISTS('DOCJOB) THEN
02600 BEGIN
02700 PRINTSTR "THE DOCTOR HAS NOT STARTED RUNNING 'DOCJOB' YET.";
02800 DO SLEEP(30) UNTIL JOB_EXISTS('DOCJOB) | PROG2(PRINTSTR "STILL HASN'T STARTED 'DOCJOB'", NIL);
02900 TERPRI PRINTSTR "OK, HE JUST STARTED IT.";
03000 SLEEP(30) % MAKE SURE HE HAS TIME TO START IT UP. %
03100 END;
03200 MESSAGE ← EXPLODEC INP(DOC, READ_MESSAGE(), NIL);
03300 OUT (OWN, PRINT_MESSAGE (MESSAGE));
03400 OK ← INP(OWN, TERPRI READ()); % T OR NIL %
03500 END;
03600 IF ¬OK THEN MESSAGE ← INP(OWN, READ_MESSAGE());
03700 WHILE BADINP (REMARK←SENTYPE (READSENT (MESSAGE))) DO MESSAGE ← INP(OWN, READ_MESSAGE()) ;
03800 IF TALK | SAVE_FILE THEN OUT (FILE1, PRINT_MESSAGE (TERPRI TERPRI MESSAGE));
03900 IF 'BYE MEMBER REMARK OR FEAR GREATERP 18.4 THEN ENDE ← T
04000 ELSE
04100 BEGIN
04200 SPECREAX (REMARK) OR DELREF (REMARK) OR SELFREF (REMARK) OR FLAREREF (REMARK)
04300 OR PERSREL (REMARK) OR NORMAL (REMARK);
04400 MODIFVAR ();
04500 END;
04600 END;
04700 SAY (IF (DELFLAG OR (FLARE NEQ 'INIT)) AND NOT (FEAR GREATERP 18.4) THEN
04800 PROG2 (AJUMP←0.1, '((OFFENDED) GOOD BYE))
04900 ELSE '(BYE));
05000 TRACEV←T;
05100 MODIFVAR ();
05200 END. _EOF_